R/monty-hall-problem (4).R

In bbeltran2395/montyhall: What the Package Does (One Line, Title Case)

#' @title
#'   Create a new Monty Hall Problem game.
#'
#' @description
#'   `create_game()` generates a new game that consists of two doors
#'   with goats behind them, and one with a car.
#'
#' @details
#'   The game setup replicates the game on the TV show "Let's
#'   Make a Deal" where there are three doors for a contestant
#'   to choose from, one of which has a car behind it and two
#'   have goats. The contestant selects a door, then the host
#'   opens a door to reveal a goat, and then the contestant is
#'   given an opportunity to stay with their original selection
#'   or switch to the other unopened door. There was a famous
#'   debate about whether it was optimal to stay or switch when
#'   given the option to switch, so this simulation was created
#'   to test both strategies.
#'
#' @param ... no arguments are used by the function.
#'
#' @return The function returns a length 3 character vector
#'   indicating the positions of goats and the car.
#'
#' @examples
#'   create_game()
#'
#' @export
create_game <- function()
{
  a.game <- sample( x=c("goat","goat","car"), size=3, replace=F )
  return( a.game )
}



#' @title
#'   Contestant chooses a door
#'
#' @description
#'   `select_door()` generates a random selection for the first choice the
#'   contestant makes.
#'
#' @details
#'   In selecting a door, the contestant will later decide if he/she wishes
#'   to stay with the originally selected door, or if they will decide to switch.
#'
#' @param ... Number between 1 and 3
#'
#' @return The function returns a length 3 character vector
#'   indicating a selection of position between 1 and 3.
#'
#' @examples
#'   select_door()
#'
#' @export
select_door <- function( )
{
  doors <- c(1,2,3)
  a.pick <- sample( doors, size=1 )
  return( a.pick )  # number between 1 and 3
}



#' @title
#'   Host opens Goat Door
#'
#' @description
#'   `open_goat_door( game, a.pick )` generates a selection made from the host,
#'   will always open a door containing a goat behind it. This selection cannot
#'   be the door the contestant initially selected.
#'
#' @details
#'   When the host opens a door revealing a goat, it cannot be a door the
#'   contestant selected, nor can it be the door containing the car. If the
#'   contestant selected the car in his/her initial selection, the host can open
#'   either of the other doors containing goats.
#'
#' @param ... If the contestant selected car, randomly select one of the two
#' goats, if contestant selected goat, select other door containing a goat.
#'
#' @return The function returns a length 3 character vector
#'   indicating a number between 1 and 3, that will indicate the door opened by
#'   the host revealing a goat.
#'
#' @examples
#'   open_goat_door( game, a.pick )
#'
#' @export
open_goat_door <- function( game, a.pick )
{
  doors <- c(1,2,3)
  # if contestant selected car,
  # randomly select one of two goats
  if( game[ a.pick ] == "car" )
  {
    goat.doors <- doors[ game != "car" ]
    opened.door <- sample( goat.doors, size=1 )
  }
  if( game[ a.pick ] == "goat" )
  {
    opened.door <- doors[ game != "car" & doors != a.pick ]
  }
  return( opened.door ) # number between 1 and 3
}



#' @title
#'   Change Doors
#'
#' @description
#'   `change_door( stay=T, opened.door, a.pick )` generates the option given to
#'   the contestant to change from their initial selection to the other door
#'   that still remains closed.
#'
#' @details
#'   The contestant is now granted a chance to change from his/her initial
#'   selection to the door that still remains closed. Contestant must now decide
#'   if they wish to stick with original selection, or change to the remaining
#'   unopened door.
#'
#' @param ... Based on the game playing strategy stay=TRUE or stay=False will be
#' assigned.
#'
#' @return The function returns a length 3 character vector
#'   indicating a number between 1 and 3, this will indicate a final pick made
#'   by the contestant.
#'
#' @examples
#'   change_door( stay=T, opened.door, a.pick )
#'
#' @export
change_door <- function( stay=T, opened.door, a.pick )
{
  doors <- c(1,2,3)
  
  if( stay )
  {
    final.pick <- a.pick
  }
  if( ! stay )
  {
    final.pick <- doors[ doors != opened.door & doors != a.pick ]
  }
  
  return( final.pick )  # number between 1 and 3
}



#' @title
#'   Determine if the contestant has won
#'
#' @description
#'   `determine_winner( final.pick, game )` generates the outcome of winning
#'   granted the contestant selects the door containing a car in his/her final
#'   pick. It also generates the outcome of losing if the contestant selects the
#'   door containing a goat in his/her final pick.
#'
#' @details
#'   Selecting the final pick as either the door that has a car behind it, or a
#'   door that has a goat behind yields the results of winning or losing at the
#'   end of the game.
#'
#' @param ... Based on the game playing strategy if the final.pick equals " the
#' return is a "WIN" if the final.pick equals "goat" the return is "LOSE"
#' assigned.
#'
#' @return The function returns "WIN" if final.pick is equal to "car", the
#' functions returns "LOSE" if final.pick is equal to "goat".
#'
#' @examples
#'   determine_winner( final.pick, game )
#'
#' @export
determine_winner <- function( final.pick, game )
{
  if( game[ final.pick ] == "car" )
  {
    return( "WIN" )
  }
  if( game[ final.pick ] == "goat" )
  {
    return( "LOSE" )
  }
}





#' @title
#'   Play the game
#'
#' @description
#'   `play_game()` generates a scenario incorporating all of what we have built
#'   putting it all together to run a simulation of whether staying with your
#'   initial selection, or switching will yield a better outcome of winning.
#'
#' @details
#'   Going through the entire game, step by step, will allow for a better
#'   understanding of the game in an attempt to determine if staying with, or
#'   switching the initial selection is best to increase chances of winning at
#'   the game.
#'
#' @param ... no arguments are used by the function.
#'
#' @return The function returns different outcomes when it is run. It will
#' determine if staying with initial selections wins or loses, same goes for
#' switching.
#'
#' @examples
#'   play_game()
#'
#' @export
play_game <- function( )
{
  new.game <- create_game()
  first.pick <- select_door()
  opened.door <- open_goat_door( new.game, first.pick )
  
  final.pick.stay <- change_door( stay=T, opened.door, first.pick )
  final.pick.switch <- change_door( stay=F, opened.door, first.pick )
  
  outcome.stay <- determine_winner( final.pick.stay, new.game  )
  outcome.switch <- determine_winner( final.pick.switch, new.game )
  
  strategy <- c("stay","switch")
  outcome <- c(outcome.stay,outcome.switch)
  game.results <- data.frame( strategy, outcome,
                              stringsAsFactors=F )
  return( game.results )
}






#' @title
#'   Building a Simulation of 100 games
#'
#' @description
#'   `play_n_games( n=100 )` generates a simulation where 100 games are played
#'   at random to determine the outcome of winning or losing.
#'
#' @details
#'   Going through a simulation where a series of games are played at random
#'   helps identify which strategy is best, when attempting to determine if
#'   switching or staying is the better move to make to increase chances of
#'   winning.
#'
#' @param ... Because the aim is to find the differences between staying and
#' switching, we are working with a sample size of at least 100 games played at
#' random to see the different outcomes of simulated games.
#'
#' @return The function returns the different outcomes, showing how many games
#' out of 100 were "WIN" and how many were "LOSE" after running the simulation.
#'
#' @examples
#'   play_n_games( n=100 )
#'
#' @export
play_n_games <- function( n=100 )
{
  
  library( dplyr )
  results.list <- list()   # collector
  loop.count <- 1
  
  for( i in 1:n )  # iterator
  {
    game.outcome <- play_game()
    results.list[[ loop.count ]] <- game.outcome
    loop.count <- loop.count + 1
  }
  
  results.df <- dplyr::bind_rows( results.list )
  
  table( results.df ) %>%
    prop.table( margin=1 ) %>%  # row proportions
    round( 2 ) %>%
    print()
  
  return( results.df )
  
}